
{*******************************************************}
{                                                       }
{       windows storage manipulation routines           }
{       windows'32 interface unit                       }
{                                                       }
{       copyright (c) 1999 maciej zagozda               }
{                                                       }
{*******************************************************}

unit StorageRoutines;

interface

uses
  Controls,
  Classes,
  Dialogs,
  ExtCtrls,
  Forms,
  Messages,
  SysUtils,
  Windows;

function GetStorageFileName( strnString: AnsiString ): AnsiString;
function GetStoragePathName( strnString: AnsiString ): AnsiString;
function GetStreamFileName( strnString: AnsiString ): AnsiString;
function GetStorageError( hresErrorResult: Hresult ): AnsiString;
procedure ShowStorageError( hresErrorCode: HResult );

implementation

uses
  FolderRoutines;

function GetStorageFileName( strnString: AnsiString ): AnsiString;
var
  intgCount: Word;
begin

  intgCount := Pos( '|', strnString );

  if intgCount  > 0 then
  begin
    Result := Copy( strnString, 1, intgCount - 1 );
  end
  else
  begin
    Result := strnString;
  end;//if

end;

function GetStoragePathName( strnString: AnsiString ): AnsiString;
var
  strnResult: AnsiString;
  intgCount: Word;
begin

  intgCount := Pos( '|', strnString );

  if intgCount > 0 then
  begin

    strnString := Copy( strnString, intgCount + 1, Length( strnString ));
    strnResult := '';

    while Pos( '\', strnString ) > 0 do
    begin
      strnResult := strnResult + Copy( strnString, 1, Pos( '\', strnString ));
      strnString := Copy( strnString, Pos( '\', strnString ) + 1, 255 );
    end;//while

    Result := Trim( strnResult );

  end
  else
  begin
    Result := '';
  end;//if

end;

function GetStreamFileName( strnString: AnsiString ): AnsiString;
var
  intgCount: Word;
begin

  intgCount := Pos( '|', strnString );

  if intgCount > 0 then
  begin

    strnString := Copy( strnString, intgCount + 1, Length( strnString ));

    while Pos( '\', strnString ) > 0 do
    begin
      strnString := Copy( strnString, Pos( '\', strnString ) + 1, 255 );
    end;//while

    Result := strnString;

  end;//if

end;

function GetStorageError( hresErrorResult: Hresult ): AnsiString;
begin

  case hresErrorResult of
    S_OK: Result := 'S_OK';
    STG_E_ACCESSDENIED: Result :=           'STG_E_ACCESSDENIED';
    STG_E_FILEALREADYEXISTS: Result :=      'STG_E_FILEALREADYEXISTS';
    STG_E_FILENOTFOUND: Result :=           'STG_E_FILENOTFOUND';
    STG_E_INSUFFICIENTMEMORY: Result :=     'STG_E_INSUFFICIENTMEMORY';
    STG_E_INVALIDFLAG: Result :=            'STG_E_INVALIDFLAG';
    STG_E_INVALIDFUNCTION: Result :=        'STG_E_INVALIDFUNCTION';
    STG_E_INVALIDNAME: Result :=            'STG_E_INVALIDNAME';
    STG_E_INVALIDPOINTER: Result :=         'STG_E_INVALIDPOINTER';
    STG_E_INVALIDPARAMETER: Result :=       'STG_E_INVALIDPARAMETER';
    STG_E_REVERTED: Result :=               'STG_E_REVERTED';
    STG_E_TOOMANYOPENFILES: Result :=       'STG_E_TOOMANYOPENFILES';
    STG_E_OLDDLL: Result :=                 'STG_E_OLDDLL';
    STG_E_OLDFORMAT: Result :=              'STG_E_OLDFORMAT';
  else
    Result := 'STG_E_UNRECOGNIZED';
  end;//case

end;

procedure ShowStorageError( hresErrorCode: HResult );
begin
  ShowMessage( GetStorageError( hresErrorCode ));
end;

end.
